library(dplyr)
library(tidyr)
library(lubridate)
library(DT)
library(plotly)
library(DescTools)

Introduction

This report utilizes the data collected by the FPL/IM Information systems team on COVID-19 vaccination in the Americas to evaluate the possibility of countries in the region to reach complete vaccination of 40% of their population (UN Populations for 2021) by December 31st, 2021 and 70% by June 30 2022

To provide insight and adequately assess how vaccination progresses, we analyzed the countries’ weekly by income

Considerations

  • The data used for each country varies depending on the date the country began vaccinating and the availability of online sources/direct weekly reports and eJRF.
  • Plots may be subject to lag due to the time countries update the data available.

Methodology

Data preparation

This report’s analysis is based on the weekly report consolidated that feeds the COVID-19 vaccination in the Americas dashboard. For the purpose of this analysis, we are using the data frame that contains aggregated completed schedule vaccination per country week.

#Doses historical from the DB
db <- read.csv("../exports/doses_historical.csv")
db_income <- db %>% 
  mutate(income_group = case_when(ISO_COUNTRY_ID %in% c("ABW", "ATG", "BMU", "BHS", "BRB", "CAN", "CHL", "CUW", "CYM", "KNA", "PRI", "SXM", "TCA", "TTO", "URY", "USA", "VGB")~ "HIGH INCOME",
                                  ISO_COUNTRY_ID %in% c("ARG", "BRA", "COL", "CRI", "CUB", "DMA", "DOM", "ECU", "GRD", "GTM", "GUY", "JAM", "LCA", "MEX", "PAN", "PER", "PRY", "SUR", "VCT")~ "UPPER MIDDLE INCOME",
                                  ISO_COUNTRY_ID %in% c("BLZ", "BOL", "HTI", "HND", "NIC", "SLV")~"LOWER MIDDLE INCOME",
                                  ISO_COUNTRY_ID %in% c("AIA", "BON", "GLP", "GUF", "MSR", "MTQ", "SAB", "SEU", "VEN") ~ "NOT REGISTERED/UNCLASSIFIED")) #%>% 
  #filter(Region == "Non-Latin Caribbean")
doses_income_country <- db_income %>% 
  group_by(CountryName,income_group, rolling_week, Year, Week) %>% 
  summarise(at_least_1d = round(sum(vaccinated_1st_dose+single_dose, na.rm = T),1), complete_schedule = round(sum(complete_schedule, na.rm = T),1), additional_dose = round(sum(sum(booster_dose, na.rm = T), sum(fourth_doses, na.rm = T)),1))
## `summarise()` has grouped output by 'CountryName', 'income_group',
## 'rolling_week', 'Year'. You can override using the `.groups` argument.
doses_income <- db_income %>% 
  group_by(income_group, rolling_week, Year,Week) %>% 
  summarise(at_least_1d = round(sum(vaccinated_1st_dose+single_dose, na.rm = T),1), complete_schedule = round(sum(complete_schedule, na.rm = T),1), additional_dose = round(sum(sum(booster_dose, na.rm = T),sum(fourth_doses, na.rm = T)),1)) 
## `summarise()` has grouped output by 'income_group', 'rolling_week', 'Year'. You
## can override using the `.groups` argument.

Aggregated data

High-income countries

fig <- plot_ly(doses_income %>% filter(income_group == "HIGH INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar',  name = 'At least 1 dose',
        marker = list(color = '#42aaff'
                      ))
fig <- fig  %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
            name = 'Complete vaccination schedule',
             marker = list(color = '#fc7f03')) %>% 
  add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
            name = 'Additional doses',
             marker = list(color = '#319165')) %>% 
  config(modeBarButtonsToRemove = c("zoom2d",
                                              "pan2d",
                                              "zoomIn2d",
                                              "zoomOut2d",
                                              "select2d",
                                              "lasso2d",
                                              "hoverCompareCartesian",
                                              "toggleSpikelines"),
         displaylogo = FALSE,
         toImageButtonOptions = list(
                       format = "png",
                       filename = "High-income countries.png",
                       width = 1200,
                       height = 600
            ))%>% 
  layout(
    legend = list(orientation = 'h',x = 0.3, y = 1.02),
    barmode = 'stack',
    title = "Upper Middle-income countries n=(19)",
    xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
    yaxis = list(title="Vaccine doses")
  )
  fig

Upper Middle-income countries

fig <- plot_ly(doses_income %>% filter(income_group == "UPPER MIDDLE INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar',  name = 'At least 1 dose',
        marker = list(color = '#42aaff'
                      ))
fig <- fig  %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
            name = 'Complete vaccination schedule',
             marker = list(color = '#fc7f03')) %>% 
  add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
            name = 'Additional doses',
             marker = list(color = '#319165')) %>% 
  config(modeBarButtonsToRemove = c("zoom2d",
                                              "pan2d",
                                              "zoomIn2d",
                                              "zoomOut2d",
                                              "select2d",
                                              "lasso2d",
                                              "hoverCompareCartesian",
                                              "toggleSpikelines"),
         displaylogo = FALSE,
         toImageButtonOptions = list(
                       format = "png",
                       filename = "Upper Middle-income countries.png",
                       width = 1200,
                       height = 600
            ))%>% 
  layout(
    legend = list(orientation = 'h',x = 0.3, y = 1.02),
    barmode = 'stack',
    title = "High-income Countries n=(17)",
    xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
    yaxis = list(title="Vaccine doses")
  )
  fig

Lower Middle-income countries

fig <- plot_ly(doses_income %>% filter(income_group == "LOWER MIDDLE INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar',  name = 'At least 1 dose',
        marker = list(color = '#42aaff'
                      ))
fig <- fig  %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
            name = 'Complete vaccination schedule',
             marker = list(color = '#fc7f03')) %>% 
  add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
            name = 'Additional doses',
             marker = list(color = '#319165')) %>% 
  config(modeBarButtonsToRemove = c("zoom2d",
                                              "pan2d",
                                              "zoomIn2d",
                                              "zoomOut2d",
                                              "select2d",
                                              "lasso2d",
                                              "hoverCompareCartesian",
                                              "toggleSpikelines"),
         displaylogo = FALSE,
         toImageButtonOptions = list(
                       format = "png",
                       filename = "Lower Middle-income countries.png",
                       width = 1200,
                       height = 600
            ))%>% 
  layout(
    legend = list(orientation = 'h',x = 0.3, y = 1.02),
    barmode = 'stack',
    title = "Lower Middle-income countries n=(6)",
    xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
    yaxis = list(title="Vaccine doses")
  )
  fig

rolling_weekly Uptake

#doses_income_uptake <- doses_income %>% 
 # group_by(income_group) %>% 
  #mutate(at_least_1d = abs(at_least_1d - lag(at_least_1d)),
   #      complete_schedule = abs(complete_schedule - lag(complete_schedule)),
    #     additional_dose = abs(additional_dose - lag(additional_dose)))

#doses_income_uptake_country <- doses_income_country %>% 
#  group_by(CountryName, income_group) %>% 
#  mutate(at_least_1d = at_least_1d - lag(at_least_1d),
#         complete_schedule = complete_schedule - lag(complete_schedule),
#         additional_dose = additional_dose - lag(additional_dose))%>% 
#  mutate(at_least_1d = ifelse(at_least_1d < 0, 0, at_least_1d)) %>% 
#  mutate(complete_schedule = ifelse(complete_schedule < 0, 0, complete_schedule)) %>% 
#  mutate(additional_dose = ifelse(additional_dose < 0, 0, additional_dose)) %>% 
#  ungroup() %>% 
#  group_by(rolling_week, income_group) %>% 
#  summarise(at_least_1d=sum(at_least_1d, na.rm = T), complete_schedule=sum(complete_schedule, na.rm = T), additional_dose=sum(additional_dose, na.rm = T))

doses_income_uptake_country <- doses_income_country %>% 
  group_by(CountryName, income_group) %>% 
  mutate(at_least_1d = at_least_1d - lag(at_least_1d),
         complete_schedule = complete_schedule - lag(complete_schedule),
         additional_dose = additional_dose - lag(additional_dose))%>% 
  mutate(at_least_1d = ifelse(at_least_1d < 0, abs(at_least_1d), at_least_1d)) %>% 
  mutate(complete_schedule = ifelse(complete_schedule < 0, abs(complete_schedule), complete_schedule)) %>% 
  mutate(additional_dose = ifelse(additional_dose < 0,abs(additional_dose), additional_dose)) 

doses_income_uptake_country2 <- doses_income_uptake_country %>% 
  ungroup() %>% 
  group_by(rolling_week, income_group) %>% 
  summarise(at_least_1d=sum(at_least_1d, na.rm = T), complete_schedule=sum(complete_schedule, na.rm = T), additional_dose=sum(additional_dose, na.rm = T))
## `summarise()` has grouped output by 'rolling_week'. You can override using the
## `.groups` argument.
doses_income_uptake <- doses_income_uptake_country2

High-income countries

fig <- plot_ly(doses_income_uptake %>% filter(income_group == "HIGH INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar',  name = 'At least 1 dose',
        marker = list(color = '#42aaff'
                      ))
fig <- fig  %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
            name = 'Complete vaccination schedule',
             marker = list(color = '#fc7f03')) %>% 
  add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
            name = 'Additional doses',
             marker = list(color = '#319165')) %>% 
  config(modeBarButtonsToRemove = c("zoom2d",
                                              "pan2d",
                                              "zoomIn2d",
                                              "zoomOut2d",
                                              "select2d",
                                              "lasso2d",
                                              "hoverCompareCartesian",
                                              "toggleSpikelines"),
         displaylogo = FALSE,
         toImageButtonOptions = list(
                       format = "png",
                       filename = "Uptake High-income countries.png",
                       width = 1200,
                       height = 600
            ))%>% 
  layout(
    legend = list(orientation = 'h',x = 0.3, y = 1.02),
    barmode = 'stack',
    title = "High-income Countries n=(17)",
    xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
    yaxis = list(title="Vaccine doses")
  )
  fig

Upper Middle-income countries

fig <- plot_ly(doses_income_uptake %>% filter(income_group == "UPPER MIDDLE INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar',  name = 'At least 1 dose',
        marker = list(color = '#42aaff'
                      ))
fig <- fig  %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
            name = 'Complete vaccination schedule',
             marker = list(color = '#fc7f03')) %>% 
  add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
            name = 'Additional doses',
             marker = list(color = '#319165')) %>% 
  config(modeBarButtonsToRemove = c("zoom2d",
                                              "pan2d",
                                              "zoomIn2d",
                                              "zoomOut2d",
                                              "select2d",
                                              "lasso2d",
                                              "hoverCompareCartesian",
                                              "toggleSpikelines"),
         displaylogo = FALSE,
         toImageButtonOptions = list(
                       format = "png",
                       filename = "Uptake Upper Middle-income countries.png",
                       width = 1200,
                       height = 600
            ))%>% 
  layout(
    legend = list(orientation = 'h',x = 0.3, y = 1.02),
    barmode = 'stack',
    title = "Upper Middle-income countries n=(7)",
    xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
    yaxis = list(title="Vaccine doses")
  )
  fig

Lower Middle-income countries

fig <- plot_ly(doses_income_uptake %>% filter(income_group == "LOWER MIDDLE INCOME"), x = ~rolling_week, y = ~at_least_1d, type = 'bar',  name = 'At least 1 dose',
        marker = list(color = '#42aaff'
                      ))
fig <- fig  %>% add_trace(x = ~rolling_week, y = ~complete_schedule, type = 'bar',
            name = 'Complete vaccination schedule',
             marker = list(color = '#fc7f03')) %>% 
  add_trace(x = ~rolling_week, y = ~additional_dose, type = 'bar',
            name = 'Additional doses',
             marker = list(color = '#319165')) %>% 
  config(modeBarButtonsToRemove = c("zoom2d",
                                              "pan2d",
                                              "zoomIn2d",
                                              "zoomOut2d",
                                              "select2d",
                                              "lasso2d",
                                              "hoverCompareCartesian",
                                              "toggleSpikelines"),
         displaylogo = FALSE,
         toImageButtonOptions = list(
                       format = "png",
                       filename = "Uptake Lower Middle-income countries.png",
                       width = 1200,
                       height = 600
            ))%>% 
  layout(
    legend = list(orientation = 'h',x = 0.3, y = 1.02),
    barmode = 'stack',
    title = "Lower Middle-income countries n=(6)",
    xaxis = list(tickangle = 90,tickvals = min(doses_income$rolling_week):max(doses_income$rolling_week), ticktext = paste0("W", min(doses_income$rolling_week):max(doses_income$rolling_week))),
    yaxis = list(title="Vaccine doses")
  )
  fig